(library (grid-gen multigrid)

(export multigrid
        make-multigrid
)

(import (guile)
        (grid-gen main)
        (grid-gen vars)
        (grid-gen code)
)
  
(defmacro multigrid args
  (for-each
    (lambda (cmd)
      (if (not (eq? cmd 'grid:join))
          (int-err "Only grid:joins allowed in multigrid!")
      )
    )
    (map car (cdr args))
  )
  (cons 'let
    (append args
      `((make-multigrid ,(cons 'list (map car (car args)))))
    )
  )
)

(define make-multigrid (lambda (grds)
  (letrec* ((cur-grid #f)
            (tau (comp-float "tau"))
            (err (comp-int "errflg"))
            (all-grds (lambda (ar)
              (let ((ogr cur-grid)
                    (res (map (lambda (gr)
                                (set! cur-grid gr)
                                (apply self ar)
                              )
                              grds
                         )
                    )
                   )
                (set! cur-grid ogr)
                res
              )
            ))
            (self (lambda args
              (if cur-grid
                  (apply cur-grid args)
                  (let ((cmd (car args)))
;;                    (format #t "mgrCMD: ~a\n" cmd)
                    (cond ((eq? cmd 'add-bnd) (all-grds args))
                          ((eq? cmd 'add-corr) (all-grds args))
                          ((eq? cmd 'subgrids) grds)
                          ((eq? cmd 'init-grid) (apply beg (all-grds args)))
                          ((eq? cmd 'init) (apply beg (all-grds args)))
                          ((eq? cmd 'update-bnd) (apply beg (all-grds args)))
                          
                          ((eq? cmd 'err) err)
                          ((eq? cmd 'tau) tau)
                          
                          ((eq? cmd 'CFL)
;;                           (format #t "mgrCFL: ~a\n" args)
                           (beg
                             (apply beg
                                    (map (lambda (gr)
                                           (set-val (gr 'tau) 
                                                    ((car grds) 'tau)
                                           )
                                         )
                                         grds
                                    )
                             )
                             (apply beg (all-grds args))
                           )
                          )
                          
                          ((eq? cmd 'load-grid-vals1)
                           (apply beg (all-grds args))
                          )
                          ((eq? cmd 'advection)
                           (apply beg (all-grds args))
                          )
                          ((eq? cmd 'correction)
                           (apply beg (all-grds args))
                          )
                          ((eq? cmd 'update-grid-vals)
                           (apply beg (all-grds args))
                          )
                          ((eq? cmd 'forall-grid-local)
                           (apply beg (all-grds args))
                          )
                          ((eq? cmd 'all-grds)
                           (apply beg (all-grds (cdr args)))
                          )
                          
                          (#t (int-err "Invalid multigrid cmd: ~a" cmd))
                    )
                  )  
              )
            ))
           )
    (all-grds `(set-tau ,tau))
    (all-grds `(set-err ,err))
    self
  )
))

)
